VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsHLSPlaylist"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal DirPath As String) As Long

Private m_objDownload As clsSimpleDownload2
Implements ISimpleDownload2

Private Const m_nMaxFileSize As Long = 65536

Private m_bFile() As Byte
Private m_nFileSize As Long
Private m_nAllocatedFileSize As Long

Private m_sText As String

Private m_bRunning As Boolean

Private m_sURL As String
Private m_fStartTime As Double, m_fStartTimeB As Double
Private m_fEndTime As Double
Private m_sSavePath As String

Private m_nFailedTime As Long

Private m_nCombineFiles As Long '0=none, 1=ts, 2=mkv
Private m_objProcess As clsRunProcess

Private Const m_nRefreshInterval As Long = 10000

Private m_nLastTime As Long 'this is GetTickCount

Private m_objDownloaded As New Collection

Private m_nTargetDuration As Long

Friend Property Get CombineFiles() As Long
CombineFiles = m_nCombineFiles
End Property

Friend Property Let CombineFiles(ByVal n As Long)
m_nCombineFiles = n
End Property

Friend Sub OnTimer()
Dim f As Double
Dim i As Long
If Not m_objDownload Is Nothing Then
 m_objDownload.RequestRetry
ElseIf m_bRunning Then
 f = Now
 If f >= m_fStartTime Then
  If m_fStartTimeB = 0 Then m_fStartTimeB = f
  If m_fEndTime > 0 And f > m_fEndTime Then
   m_sText = "Finished"
   Running = False
   Exit Sub
  End If
  i = GetTickCount
  If i >= m_nLastTime + m_nRefreshInterval Then
   m_nLastTime = i
   '///
   m_sText = "Refreshing"
   Erase m_bFile
   m_nFileSize = 0
   m_nAllocatedFileSize = 0
   Set m_objDownload = New clsSimpleDownload2
   m_objDownload.StartDownload m_sURL, Me, , 3
   '///
  End If
 End If
End If
End Sub

Friend Property Get URL() As String
URL = m_sURL
End Property

Friend Property Let URL(ByVal s As String)
Dim i As Long
s = Trim(Replace(s, vbTab, " "))
i = InStr(1, s, " ")
If i > 0 Then s = Left(s, i - 1)
m_sURL = s
End Property

Friend Property Get StartTime() As Double
StartTime = m_fStartTime
End Property

Friend Property Let StartTime(ByVal f As Double)
m_fStartTime = f
End Property

Friend Property Get EndTime() As Double
EndTime = m_fEndTime
End Property

Friend Property Let EndTime(ByVal f As Double)
m_fEndTime = f
End Property

Friend Property Get SavePath() As String
SavePath = m_sSavePath
End Property

Friend Property Let SavePath(ByVal s As String)
s = Trim(s)
s = Replace(s, "/", "\")
s = Replace(s, "\\", "\")
m_sSavePath = s
s = s + "\"
s = Replace(s, "\\", "\")
MakeSureDirectoryPathExists s
End Property

Friend Property Get Text() As String
Dim s As String
s = m_sText
If m_nFailedTime > 0 Then
 s = s + " (failed " + CStr(m_nFailedTime) + " times)"
End If
Text = s
End Property

Friend Property Get Running() As Boolean
Running = m_bRunning
End Property

Friend Property Let Running(ByVal b As Boolean)
m_bRunning = b
If Not b Then
 If Not m_objDownload Is Nothing Then
  m_objDownload.StopDownload
  Set m_objDownload = Nothing
 End If
 '///try to save all downloaded videos to a playlist
 pSavePlaylist
 Set m_objDownloaded = New Collection
 '///stop ffmpeg (if all downloads are finished)
 Set m_objProcess = Nothing
End If
End Property

Private Sub Class_Terminate()
Running = False
End Sub

Private Sub ISimpleDownload2_OnError(ByVal ErrorNumber As Long, ByVal ErrorDescription As String)
Set m_objDownload = Nothing
m_sText = "Download failed, retry after " + CStr(m_nRefreshInterval \ 1000) + " seconds"
m_nFailedTime = m_nFailedTime + 1
End Sub

Private Sub ISimpleDownload2_OnResponseDataAvailable(ByVal nOffset As Long, ByVal nSize As Long, Data() As Byte)
If nOffset < 0 Or nSize < 0 Or nOffset + nSize > m_nAllocatedFileSize Then
 Debug.Assert False
 Exit Sub
End If
CopyMemory m_bFile(nOffset), Data(0), nSize
If nOffset + nSize > m_nFileSize Then m_nFileSize = nOffset + nSize
End Sub

Private Sub ISimpleDownload2_OnResponseFinished()
Set m_objDownload = Nothing
'///
If m_nFileSize <> m_nAllocatedFileSize Then
 If m_nFileSize > 0 Then
  ReDim Preserve m_bFile(m_nFileSize - 1)
 Else
  Erase m_bFile
 End If
End If
'///
m_sText = "OK"
pProcess
End Sub

Private Sub ISimpleDownload2_OnResponseStart(ByVal nFileSize As Long)
If nFileSize > m_nMaxFileSize Then
 m_objDownload.StopDownload
 Set m_objDownload = Nothing
 m_sText = "File too big"
 m_nFailedTime = m_nFailedTime + 1
 Running = False
 Exit Sub
End If
'///usually this file is of unknown size
If nFileSize > 0 Then m_nAllocatedFileSize = nFileSize Else m_nAllocatedFileSize = m_nMaxFileSize
ReDim m_bFile(m_nAllocatedFileSize - 1)
m_nFileSize = 0
End Sub

Private Sub pProcess()
On Error Resume Next
Dim v() As String
Dim s As String, s2 As String
Dim lps As Long
Dim i As Long, m As Long
Dim fDuration As Single
'///
If m_nFileSize = 0 Then Exit Sub
'///
s = UTF8DecodeByteArray(m_bFile)
s = Replace(s, vbCr, vbNullString)
v = Split(s, vbLf)
'///
m = UBound(v)
If m >= 0 Then
 If v(0) <> "#EXTM3U" Then m = -1
End If
If m < 0 Then
 m_sText = "Invalid playlist format"
 m_nFailedTime = m_nFailedTime + 1
 Running = False
 Exit Sub
End If
'///
For i = 0 To m
 s = Trim(Replace(v(i), vbTab, " "))
 If Left(s, 1) = "#" Then
  If Left(s, 4) = "#EXT" Then
   lps = InStr(1, s, ":")
   If lps > 0 Then s2 = Left(s, lps - 1) Else s2 = s
   Select Case s2
   Case "#EXTINF"
    s = Mid(s, lps + 1)
    lps = InStr(1, s, ",")
    If lps > 0 Then s = Left(s, lps - 1)
    fDuration = Val(s)
   Case "#EXT-X-ENDLIST"
    m_sText = "End of playlist"
    Running = False
    Exit Sub
   Case "#EXT-X-TARGETDURATION"
    lps = Val(Mid(s, lps + 1))
    If lps > m_nTargetDuration Then m_nTargetDuration = lps
   Case "#EXT-X-MEDIA", "#EXT-X-STREAM-INF", "#EXT-X-I-FRAME-STREAM-INF", "#EXT-X-SESSION-DATA", "#EXT-X-SESSION-KEY"
    m_sText = "Unsupported playlist format"
    m_nFailedTime = m_nFailedTime + 1
    Running = False
    Exit Sub
   End Select
  End If
 ElseIf s <> vbNullString Then 'it should be a URL
  pAdd s, fDuration
  fDuration = 0
 End If
Next i
End Sub

Private Sub pAdd(ByVal sURL As String, ByVal fDuration As Single)
On Error Resume Next
Dim i As Long
Dim s As String
Dim obj As clsHLSVideo
'///
If LCase(Left(sURL, 7)) <> "http://" Then
 i = InStrRev(m_sURL, "/")
 If i > 0 Then
  sURL = Left(m_sURL, i) + sURL
 Else
  Debug.Assert False
  Exit Sub
 End If
End If
'///
i = InStrRev(sURL, "/")
If i > 0 Then s = Mid(sURL, i + 1) Else s = sURL
'///check if this file is new
Err.Clear
m_objDownloaded.Add "#EXTINF:" + Format(fDuration, "0.000") + "," + vbCrLf + s, StringToHex(s)
If Err.Number = 0 Then
 Set obj = New clsHLSVideo
 obj.URL = sURL
 obj.Duration = fDuration
 obj.StartTime = Now
 If m_nCombineFiles <> 0 Then
  s = m_sURL
  i = InStrRev(s, "/")
  If i > 0 Then s = Mid(s, i + 1)
  i = InStrRev(s, ".")
  If i > 0 Then s = Left(s, i - 1)
  s = s + Format(m_fStartTimeB, "-yyyymmdd-hhmmss")
  Select Case m_nCombineFiles
  Case 2 'mkv
   s = s + ".mkv"
   If m_objProcess Is Nothing Then Set m_objProcess = New clsRunProcess
  Case Else
   s = s + ".ts"
  End Select
 End If
 obj.FileName = m_sSavePath + "\" + s
 obj.CombineFiles = m_nCombineFiles
 Set obj.TheProcess = m_objProcess
 Form1.AddHLSVideo obj
End If
End Sub

Private Sub pSavePlaylist()
On Error Resume Next
Dim v As Variant
Dim s As String, s2 As String
Dim i As Long
'///
If m_objDownloaded.Count > 0 And m_nCombineFiles = 0 Then
 s = m_sURL
 i = InStrRev(s, "/")
 If i > 0 Then s = Mid(s, i + 1)
 s2 = Format(m_fStartTimeB, "-yyyymmdd-hhmmss")
 i = InStrRev(s, ".")
 If i > 0 Then s = Left(s, i - 1) + s2 + Mid(s, i) Else s = s + s2
 Err.Clear
 Open m_sSavePath + "\" + s For Output As #1
 If Err.Number = 0 Then
  Print #1, "#EXTM3U" + vbCrLf + "#EXT-X-VERSION:3" + vbCrLf + "#EXT-X-PLAYLIST-TYPE:VOD" + vbCrLf + "#EXT-X-TARGETDURATION:" + CStr(m_nTargetDuration)
  For Each v In m_objDownloaded
   Print #1, CStr(v)
  Next v
  Print #1, "#EXT-X-ENDLIST"
 End If
 Close
End If
End Sub
